program test;

uses Crt,Dos;

const
   maxntestmax  = 100;    (* numero de tests a realizar *)
   maxnmax      = 50;     (* numero de preguntas en la base *)
   maxmmax      = 5;      (* numero de respuestas por pregunta *)
   maxnpre      = 50;     (* numero de preguntas de un test *)
   maxmres      = 5;      (* numero de respuestas de un test = nmax *)

type
   tipolinea     = string [255];
   tipopregunta  = string [255];
   tiporespuesta = string [128];
var
   ntestmax  : integer;    (* numero de tests a realizar *)
   nmax      : integer;    (* numero de preguntas en la base *)
   mmax      : integer;    (* numero de respuestas por pregunta *)
   npre      : integer;    (* numero de preguntas de un test *)
   mres      : integer;    (* numero de respuestas de un test = nmax *)
   nprepag   : integer;    (* Numero de preguntaspor pagina *)
   fecha     : string[30];
   fichero   : string[14];
   pregunta  : array [1..maxnmax] of tipopregunta;
   respuesta : array [1..maxnmax,1..maxmmax] of tiporespuesta;
   n,m       : integer;
   ntest     : integer;
   solucion  : array [1..maxntestmax,1..maxnpre] of char;
   _rnd      : real; (* semilla = 35.78921  *)
   lst       : text;
   numero      : integer;
   tema        : integer;
   fechapreg   : string;
   fechaexamen : string;

(***************************************************)
(*   NUEVA PAGINA                                  *)
(***************************************************)
procedure Nuevapagina;
var i : integer;
begin
write(lst,#12);
end;

(****************************************************************)


(***************************************************)
(*   CORTARLINEA                                   *)
(***************************************************)
procedure cortarlinea(linea:tipolinea; longitud:integer;
                       var linea1,linea2 : tipolinea);
var i,j : integer;
begin
if length(linea)<=longitud then
  begin
   linea1:=linea;
   linea2:='';
  end
  else begin
    i:=longitud+1;
    while linea[i]<>' ' do i:=i-1;
    linea1:=copy(linea,1,i);
    linea2:=copy(linea,i+1,length(linea)-i);
  end;
end;


(***************************************************)
(*   PARAMETROS                                    *)
(***************************************************)
procedure Parametros;   (* Este procedimiento no se usa *)
var ch: char;
begin

clrscr;
write('Tipo de examen y fecha                         : ');readln(fecha);
write('Fichero de la base de preguntas                : ');readln(fichero);
write('Parametros habituales  (S/N)                   : ');readln(ch);
if upcase(ch)='N'
  then begin
    write('Numero de preguntas en la base                 : ');readln(nmax);
    write('Numero de respuestas por pregunta              : ');readln(mmax);
    write('Numero de test a realizar                      : ');readln(ntestmax);
    write('Numero de preguntas de un test                 : ');readln(npre);
    (* write('Numero de respuestas por pregunta en el test   : ');readln(mres); *) mres:=mmax;
    write('Numero de preguntas por pagina                 : ');readln(nprepag);
    write('Semilla para la generacion aleatoria           : ');readln(_rnd);
  end
  else begin
    nmax:=10;
    mmax:=4;
    ntestmax:=5;
    npre:=10;
    mres:=mmax;
    nprepag:=5;
    _rnd:=0;
  end;
_rnd:=35.78921+_rnd;
write('--------------------------------------------------------');

end;


(***************************************************)
(*   ESCRIBIRPREGUNTA                              *)
(***************************************************)
procedure Escribirpregunta  (n,i : integer);
var   linea,linea1 : tipolinea;
      j            : integer;
begin
  writeln(lst);
  writeln(lst);
  writeln(lst,'TEMA : ',tema,'   FECHA : ',fechapreg,'                                   EXAMEN : ',fechaexamen);
  for j:=1 to 79 do write(lst,'-');writeln(lst);
  linea:=pregunta[i];
  cortarlinea(linea,62,linea1,linea);
  writeln(lst,'   ',n:3,')  ',linea1);
  while linea<>'' do
    begin
      cortarlinea(linea,62,linea1,linea);
      writeln(lst,'         ',linea1);
    end;
  writeln(lst);
end;


(***************************************************)
(*   ESCRIBIRRESPUESTA                             *)
(***************************************************)
procedure EscribirRespuesta (m,i,j : integer);
const margen = '         ';
var   linea,linea1 : tipolinea;
begin
  linea:=respuesta[i,j];
  cortarlinea(linea,59,linea1,linea);
  writeln(lst,margen,chr(64+m), ') ',linea1);
  while linea<>'' do
    begin
      cortarlinea(linea,59,linea1,linea);
      writeln(lst,margen,'   ',linea1);
    end;
end;


(***************************************************)
(*   LEERYESCRIBIR                                 *)
(***************************************************)
procedure LeeryEscribir;
var
  test : text;
  i,j  : integer;
  comentario : string[40];

begin
  assign(test,'TEST.DOC');
  reset (test);
  readln(test);
  readln(test,comentario,fecha);
  readln(test,comentario,nmax);
  readln(test,comentario,mmax);
  readln(test,comentario,ntestmax);
  readln(test,comentario,npre);
  readln(test,comentario,nprepag);
  readln(test);
  mres :=mmax;
  for i:=1 to nmax do
    begin
      readln(test,numero);
      readln(test,tema);
      readln(test,fechapreg);
      readln(test,fechaexamen);
      readln(test,pregunta[1]);
      for j:=1 to mmax do
         readln(test,respuesta[1,j]);
      readln(test);
      if (i mod nprepag)=1 then Nuevapagina;
      EscribirPregunta(numero,1);
      for j:=1 to mmax do
         EscribirRespuesta(j,1,j);
    end;
  close(test);
end;


begin
(* Parametros; *)
  assign (lst,'PRN');
  rewrite(lst);
  LeeryEscribir;
  close(lst);
end.
